home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / utils / tngsd100.zip / RD2SD.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-11  |  5KB  |  211 lines
  1. {$N-,E- no math support needed}
  2. {$X- function calls may not be discarded}
  3. {$I- disable I/O checking (trap errors by checking IOResult)}
  4.  
  5. PROGRAM star_date_maker;
  6. USES DOS, NumDays;
  7.  
  8. PROCEDURE showhelp (errornum : BYTE);
  9. VAR
  10.   message : STRING [60];
  11. BEGIN
  12.   WriteLn;
  13.   WriteLn ('  Usage :  RD2SD mm-dd-yyyy hour');
  14.   WriteLn ('   or   :  RD2SD c  <- Current date will be converted');
  15.   WriteLn ('   or   :  RD2SD p  <- Prompt for a date to be converted');
  16.   WriteLn;
  17.   IF errornum > 0 THEN BEGIN
  18.     CASE errornum OF
  19.       2 : message := 'Couldn''t find sufficient numbers on the command line.';
  20.       3 : message := 'First number out of range for a MONTH value.';
  21.       4 : message := 'Second number out of range for a DAY value.';
  22.       5 : message := 'Third number out of range for a YEAR value.';
  23.       6 : message := 'Fourth number out of range for a HOUR value.';
  24.       ELSE  message := 'Unanticipated error of unknown type.';
  25.     END;
  26.     WriteLn;
  27.     WriteLn ('ERROR: (#', errornum, ') - ', message);
  28.   END;
  29.   Halt (errornum);
  30. END;
  31.  
  32. FUNCTION GetNumeric (w: STRING; rLow, rHigh :WORD) : INTEGER;
  33. VAR
  34.   s : STRING;
  35.   n,
  36.   vErr : INTEGER;
  37. BEGIN
  38.   REPEAT
  39.     Write ('Please specify a', w, ', in the range ', rLow, ' to ', rHigh, ': ');
  40.     ReadLn (s);
  41.     Val (s, n, vErr);
  42.   UNTIL (vErr = 0) AND (n >= rLow) AND (n <= rHigh);
  43.   GetNumeric := n;
  44. END;
  45.  
  46. PROCEDURE GetUserDate (VAR cDay, cMonth, cYear : INTEGER; VAR cHour: REAL);
  47. BEGIN
  48.   WriteLn;
  49.   cMonth := GetNumeric (' month', 1, 12);
  50.   cDay   := GetNumeric (' date', 1, 31);
  51.   cYear  := GetNumeric (' year', 1583, 9999);
  52.   cHour  := GetNumeric ('n hour', 0, 23);
  53. END;
  54.  
  55. PROCEDURE GetCurrDate (VAR cDay, cMonth, cYear : INTEGER; VAR cHour: REAL);
  56. VAR
  57.   y, m, d, w,
  58.   h, n, s, c : WORD;
  59.  
  60. BEGIN
  61.   GetDate (y, m, d, w);
  62.   GetTime (h, n, s, c);
  63.  
  64.   cDay := d;
  65.   cMonth := m;
  66.   cYear := y;
  67.   cHour := h;
  68. END;
  69.  
  70. FUNCTION BuildCommandLine: STRING;
  71. VAR
  72.   i : BYTE;
  73.   CmdLine : STRING;
  74. BEGIN
  75.   CmdLine := '';
  76.   FOR i := 1 to ParamCount DO
  77.     CmdLine := CmdLine + #32 + ParamStr (i);
  78.   BuildCommandLine := CmdLine + #32;
  79. END;
  80.  
  81. FUNCTION ParseNumber (CmdLine: STRING; VAR i: BYTE): STRING;
  82. VAR
  83.   s: STRING;
  84. BEGIN
  85.   REPEAT
  86.     Inc (i);
  87.     IF (i > Length (CmdLine)) THEN ShowHelp (2);
  88.   UNTIL (CmdLine[i] IN ['0'..'9']);
  89.  
  90.   s := '';
  91.   REPEAT
  92.     s := s + CmdLine[i];
  93.     Inc (i);
  94.     IF (i > Length (CmdLine)) THEN ShowHelp (2);
  95.   UNTIL (NOT (CmdLine[i] IN ['0'..'9']));
  96.   ParseNumber := s;
  97. END;
  98.  
  99. PROCEDURE GetParmDate (VAR cDay, cMonth, cYear : INTEGER; VAR cHour: REAL);
  100. VAR
  101.   cYearStr,
  102.   cMonthStr,
  103.   cDayStr,
  104.   cHourStr : STRING;
  105.  
  106.   i : BYTE;
  107.   CmdLine : STRING;
  108.   vErr : INTEGER;
  109.  
  110. BEGIN
  111.   CmdLine := BuildCommandLine;
  112.   i := 0;
  113.  
  114.   cMonthStr := ParseNumber (CmdLine, i);
  115.   cDayStr   := ParseNumber (CmdLine, i);
  116.   cYearStr  := ParseNumber (CmdLine, i);
  117.   cHourStr  := ParseNumber (CmdLine, i);
  118.  
  119.   Val (cMonthStr, cMonth, vErr);
  120.     IF (vErr <> 0) OR (cMonth < 1) OR (cMonth > 12) THEN ShowHelp (3);
  121.  
  122.   Val (cDayStr, cDay, vErr);
  123.     IF (vErr <> 0) OR (cDay < 1) OR (cDay > 31) THEN ShowHelp (4);
  124.  
  125.   Val (cYearStr, cYear, vErr);
  126.     IF (vErr <> 0) THEN
  127.       ShowHelp (5)
  128.     ELSE BEGIN
  129.       IF ((cYear >= 0) AND (cYear < 80)) THEN
  130.         cYear := 2000 + cYear
  131.       ELSE
  132.       IF ((cYear >= 80) AND (cYear <= 99)) THEN
  133.         cYear := 1900 + cYear
  134.       ELSE
  135.       IF ((cYear < 1583) OR (cYear > 9999)) THEN ShowHelp (5);
  136.     END;
  137.  
  138.   Val (cHourStr, cHour, vErr);
  139.     IF (vErr <> 0) OR (cHour < 0) OR (cHour > 23) THEN ShowHelp (6);
  140. END;
  141.  
  142. VAR
  143.   HoursInYear,
  144.   Days,
  145.   Hours,
  146.   stardate : REAL;
  147.  
  148.   cDay,
  149.   cMonth,
  150.   cYear : INTEGER;
  151.  
  152.   CurrentDate,
  153.   FirstOfYear : Date;
  154.  
  155.   sdStr : STRING;
  156.  
  157. BEGIN
  158.   WriteLn ('RD2SD v1.00 - Free DOS tool: real date to star date convertor.');
  159.   WriteLn ('April 11, 1996. Copyright (c) 1996 by David Daniel Anderson - Reign Ware.');
  160.  
  161.   IF (ParamCount = 0) THEN ShowHelp (0);
  162.  
  163.   IF (ParamStr (1) = 'p')
  164.     THEN GetUserDate (cDay, cMonth, cYear, Hours) ELSE
  165.   IF (ParamStr (1) = 'c')
  166.     THEN GetCurrDate (cDay, cMonth, cYear, Hours)
  167.     ELSE GetParmDate (cDay, cMonth, cYear, Hours);
  168.  
  169.   WITH CurrentDate DO
  170.   BEGIN
  171.     CASE cMonth OF
  172.       1 : Mo := Jan;
  173.       2 : Mo := Feb;
  174.       3 : Mo := Mar;
  175.       4 : Mo := Apr;
  176.       5 : Mo := May;
  177.       6 : Mo := Jun;
  178.       7 : Mo := Jul;
  179.       8 : Mo := Aug;
  180.       9 : Mo := Sep;
  181.      10 : Mo := Oct;
  182.      11 : Mo := Nov;
  183.      12 : Mo := Dec;
  184.     END;
  185.     Da := cDay;
  186.     Yr := cYear;
  187.   END;
  188.   WITH FirstOfYear DO
  189.   BEGIN
  190.     Mo := Jan;
  191.     Da := 1;
  192.     Yr := CurrentDate.Yr;
  193.   END;
  194.  
  195.   Days := 1 + NumOfDays (CurrentDate) - NumOfDays (FirstOfYear);
  196.   IF IsLeapYear (CurrentDate.Yr)
  197.     THEN HoursInYear := 8784
  198.     ELSE HoursInYear := 8760;
  199.  
  200.   stardate := ((((Days - 1) * 24) + Hours) * (1000 / HoursInYear));
  201.   Str (stardate:0:2, sdStr);
  202.   WHILE (Length (sdStr) < 6) DO sdStr := '0'+sdStr;
  203.  
  204.   WriteLn;
  205.   WITH CurrentDate DO
  206.     WriteLn ('Real date = ', Ord (mo) + 1, '-', da, '-', yr, ' ', Hours:0:0, ':00');
  207.   WriteLn;
  208.   WriteLn ('Star date = ',  CurrentDate.Yr-2323, ',', sdStr);
  209.   WriteLn;
  210. END.
  211.